home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / CRYSTAL / APPLMGR.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-11-06  |  6.0 KB  |  293 lines
  1. IMPLEMENTATION MODULE ApplMgr;
  2.  
  3. (*
  4. AES Application Manager.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM AES      IMPORT Global,IntIn,IntOut,Addr,crystal,Version,Integer;
  12. FROM PORTAB   IMPORT SIGNEDWORD,UNSIGNEDWORD,WORDSET,ANYTYPE,ANYPOINTER;
  13. FROM SYSTEM   IMPORT ADR;
  14.  
  15. #if (defined LPRM2) || (defined SPCM2)
  16. FROM SYSTEM   IMPORT SETREG,INLINE;
  17. FROM Register IMPORT D1;
  18. #elif (defined TDIM2) || (defined FTLM2)
  19. FROM SYSTEM   IMPORT SETREG,CODE;
  20. FROM Register IMPORT D1;
  21. #elif (defined ANAM2)
  22. FROM SYSTEM   IMPORT SETREG,CODE;
  23. FROM Register IMPORT D1;
  24. #elif (defined HM2)
  25. FROM SYSTEM   IMPORT LOAD,CODE;
  26. FROM Register IMPORT D1;
  27. #elif (defined MM2)
  28. FROM SYSTEM   IMPORT CADR,LOAD,ASSEMBLER;
  29. FROM Register IMPORT D1;
  30. #elif (defined FSTM2)
  31. FROM SYSTEM   IMPORT ASSEMBLER;
  32. #elif (defined LM2)
  33. FROM SYSTEM   IMPORT SETREG,CX,DX,SWI;
  34. #elif (defined SDSM2)
  35. FROM SYSTEM   IMPORT RegCX,RegDX,SWI;
  36. #elif (defined TSM2_1)
  37. FROM AESSYS   IMPORT applyield;
  38. #elif (defined TSM2_2)
  39. FROM SYSTEM   IMPORT BYTE;
  40. #endif
  41. CAST_IMPORT
  42. #if ST
  43. FROM AES IMPORT KAOS;
  44. #endif
  45.  
  46. #if Seimet
  47. CONST F10 = 00A000100H;
  48.       F11 = 00B020101H;
  49.       F12 = 00C020101H;
  50.       F13 = 00D000101H;
  51.       F14 = 00E020101H;
  52.       F15 = 00F010101H;
  53.       F16 = 010020100H;
  54.       F17 = 011000100H;
  55.       F18 = 012010301H;
  56.       F19 = 013000100H;
  57.       F24 = 018020100H;
  58. #endif
  59.  
  60. PROCEDURE applinit(): SIGNEDWORD;
  61. BEGIN
  62.   crystal(10,0,1,0);
  63. #if ST
  64.   KAOS:= IntIn.Magic = 04B414F53H;
  65. #endif
  66.   RETURN IntOut[0];
  67. END applinit;
  68.  
  69. PROCEDURE ApplRead(    Id     : SIGNEDWORD;
  70.                        Length : UNSIGNEDWORD;
  71.                    VAR PBuffer: ARRAY OF ANYTYPE): BOOLEAN;
  72. BEGIN
  73.   WITH IntIn DO
  74.     Array[0]:= Id;
  75.     Array[1]:= Length;
  76.   END;
  77.   Addr[0]:= ADR(PBuffer);
  78.   crystal(11,2,1,1);
  79.   RETURN IntOut[0] > 0;
  80. END ApplRead;
  81.  
  82. PROCEDURE ApplWrite(    Id     : SIGNEDWORD;
  83.                         Length : UNSIGNEDWORD;
  84.                     VAR PBuffer: ARRAY OF ANYTYPE);
  85. BEGIN
  86.   WITH IntIn DO
  87.     Array[0]:= Id;
  88.     Array[1]:= Length;
  89.   END;
  90.   Addr[0]:= ADR(PBuffer);
  91.   crystal(12,2,1,1);
  92. END ApplWrite;
  93.  
  94. PROCEDURE ApplFind(PName: ANYPOINTER): SIGNEDWORD;
  95. BEGIN
  96.   Addr[0]:= PName; (* pointer because of AES 4.0 *)
  97.   crystal(13,0,1,1);
  98.   RETURN IntOut[0];
  99. END ApplFind;
  100.  
  101. PROCEDURE ApplTPlay(PTape : TapePtr;
  102.                     Length: EventTape;
  103.                     Scale : UNSIGNEDWORD);
  104. BEGIN
  105. #if ST
  106.   IF Version() >= 0120H THEN
  107. #endif
  108.     WITH IntIn DO
  109.       Array[0]:= Length;
  110.       Array[1]:= Scale;
  111.     END;
  112.     Addr[0]:= PTape;
  113.     crystal(14,2,1,1);
  114. #if ST
  115.   ELSE
  116.     IntOut[0]:= 0; (* error *)
  117.   END;
  118. #endif
  119. END ApplTPlay;
  120.  
  121. PROCEDURE ApplTRecord(PTape : TapePtr;
  122.                       Length: EventTape): EventTape;
  123. BEGIN
  124. #if ST
  125.   IF Version() >= 0120H THEN
  126. #endif
  127.     IntIn.Array[0]:= Length;
  128.     Addr[0]:= PTape;
  129.     crystal(15,1,1,1);
  130.     RETURN IntOut[0];
  131. #if ST
  132.   ELSE
  133.     RETURN 0; (* error *)
  134.   END;
  135. #endif
  136. END ApplTRecord;
  137.  
  138. PROCEDURE ApplBVSet(BVDisk: WORDSET;
  139.                     BVHard: WORDSET);
  140. BEGIN
  141. #if ST
  142. #if ABC
  143. #warning ...taking care of ABC-GEM
  144.   IF (Version() = 0220H) OR (Version() = 1042H) OR (Version() = 0399H) THEN
  145. #endif
  146. #else
  147.   IF Version() >= 0220H THEN (* GEM 2.x, GEM 3.x *)
  148. #endif
  149.  
  150. #if ST
  151. #if ABC
  152.     WITH IntIn DO
  153.       Array[0]:= CAST(Integer,BVDisk);
  154.       Array[1]:= CAST(Integer,BVHard);
  155.     END;
  156.     crystal(16,2,1,0);
  157.   END;
  158. #else
  159.  
  160. #endif
  161. #else
  162.     WITH IntIn DO
  163.       Array[0]:= CAST(Integer,BVDisk);
  164.       Array[1]:= CAST(Integer,BVHard);
  165.     END;
  166.     crystal(16,2,1,0);
  167.   END;
  168. #endif
  169. END ApplBVSet;
  170.  
  171. PROCEDURE ApplYield;
  172. #if (defined MM2)
  173. (*$L-*)
  174. #endif
  175.  
  176. CONST OpCode = 0C9H;
  177.  
  178. #if (defined ANAM2) || (defined LPRM2) || (defined SPCM2) || \
  179.     (defined HM2)   || (defined TDIM2) || (defined FTLM2)
  180.       trap2  = 4E42H;
  181. #elif (defined LM2) || (defined FSTM2) || (defined SDSM2) || \
  182.       (defined TSM2_2)
  183.       GEM    = 0EFH;
  184. #endif
  185.  
  186. #ifdef TSM2_2
  187.  
  188. TYPE CODE = ARRAY[0..7] OF BYTE;
  189.  
  190. (*#call(inline=>on) *)
  191. PROCEDURE applyield = CODE(0B9H,0C9H,000H, (* mov cx,OpCode *)
  192.                            0BAH,000H,000H, (* mov dx,0      *)
  193.                            0CDH,GEM);      (* int GEM       *)
  194. (*#call(inline=>off) *)
  195. #endif
  196.  
  197. BEGIN
  198. #if (defined LPRM2) || (defined SPCM2)
  199.   INLINE(303CH,OpCode); (* move.w #OpCode,d0 *)
  200.   INLINE(trap2);        (* trap   #2         *)
  201.  
  202. #elif (defined HM2)
  203.   CODE(303CH);  (* move.w #OpCode,d0 *)
  204.   CODE(OpCode);
  205.   CODE(trap2);  (* trap   #2         *)
  206.  
  207. #elif (defined TDIM2) || (defined ANAM2) || (defined FTLM2)
  208.   CODE(303CH,OpCode); (* move.w #OpCode,d0 *)
  209.   CODE(trap2);        (* trap   #2         *)
  210.  
  211. #elif (defined MM2)
  212.   ASSEMBLER
  213.     MOVE.W #OpCode,D0
  214.     TRAP   #2
  215.   END;
  216.  
  217. #elif (defined MSM2)
  218.   (*$A+*)
  219.     MOVE.W #OpCode,D0
  220.     TRAP   #2
  221.   (*$A-*)
  222.  
  223. #elif (defined FSTM2)
  224.   ASM
  225.     MOV CX,OpCode
  226.     MOV DX,0
  227.     INT GEM
  228.   END;
  229.  
  230. #elif (defined LM2)
  231.   SETREG(CX,OpCode);
  232.   SETREG(DX,0);
  233.   SWI(GEM);
  234.  
  235. #elif (defined SDSM2)
  236.   RegCX:= OpCode;
  237.   RegDX:= 0;
  238.   SWI(GEM);
  239.  
  240. #elif (defined TSM2_1) || (defined TSM2_2)
  241.   applyield;
  242.  
  243. #elif (defined XAM2) || (defined XHM2)
  244.   crystal(17,0,1,0);
  245.  
  246. #endif
  247. (* alternatively:
  248.  
  249.   WITH IntIn DO
  250.     Array[0]:= 0;
  251.     Array[1]:= 0;
  252.   END;
  253.   crystal(24,2,1,0);
  254.  
  255.    for KAOS, GEM 2.x or higher only:
  256.  
  257.   crystal(17,0,1,0);
  258.  
  259. *)
  260. END ApplYield;
  261. #if (defined MM2)
  262. (*$L= *)
  263. #endif
  264.  
  265. PROCEDURE ApplSearch(    Mode: UNSIGNEDWORD;
  266.                      VAR Name: ARRAY OF CHAR;
  267.                      VAR Type: UNSIGNEDWORD;
  268.                      VAR Id  : UNSIGNEDWORD): BOOLEAN;
  269. BEGIN
  270. #if ST
  271.   IF (Version() >= 0399H) AND (Version() < 1042H) THEN
  272.     IntIn.Array[0]:= Mode;
  273.     Addr[0]:= ADR(Name);
  274.     crystal(18,1,3,1);
  275.     Type:= IntOut[1];
  276.     Id:= IntOut[2];
  277.     RETURN IntOut[0] = 1;
  278.   END;
  279. #endif
  280.   RETURN FALSE;
  281. END ApplSearch;
  282.  
  283. PROCEDURE applexit;
  284. BEGIN
  285.   crystal(19,0,1,0);
  286.   Global.ApVersion:= 0;
  287. END applexit;
  288.  
  289. BEGIN
  290.   ApplInit:= applinit;
  291.   ApplExit:= applexit;
  292. END ApplMgr.
  293.